home *** CD-ROM | disk | FTP | other *** search
/ The Epic Collection 3 / Epic Collection 3, The (1997)(Epic Marketing)[!].iso / internet / ums / ums11.6 / rexx / listmanager.rexx < prev    next >
OS/2 REXX Batch file  |  1996-09-08  |  42KB  |  1,247 lines
  1. /* ------------------------------------------------------------------------
  2. :Program.    ListManager
  3. :Contents.   transfers mail from a mailing list to a group and vice versa
  4. :Author.     Kai Bolay [kai]
  5. :Address.    Snail Mail:              EMail:
  6. :Address.    Hoffmannstraße 168       UseNet: kai@studbox.uni-stuttgart.de
  7. :Address.    D-71229 Leonberg         FIDO: 2:2407/106.3
  8. :Author.     hartmut Goebel [hG]
  9. :Address.    Aufsesßplatz 5           UseNet: hartmut@oberon.nbg.sub.org
  10. :Address.    D-90459 Nürnberg
  11. :Author.     Martin Horneffer [mh]
  12. :Address.    Warmweiherstr.18         UseNet: mh@umshq.dfv.rwth-aachen.de
  13. :Address.    D-52066 Aachen           Maus: mh@AC2
  14. :Copyright.  Public Domain
  15. :Language.   ARexx
  16. :Translator. RexxMast
  17.  
  18. $Id: ListManager.rexx,v 1.20 1995/05/30 18:59:00 hartmut Exp hartmut $
  19. $Log: ListManager.rexx,v $
  20. # Revision 1.20  1995/05/30  18:59:00  hartmut
  21. # fixed missing f_CDEF
  22. # debuglevel defaults to 5 again, as described in docs
  23. #
  24. # Revision 1.19  1995/05/22  15:08:29  hartmut
  25. # fixed Errors-To:-Header
  26. # fixed dupes check for listmails and thus processing loop
  27. #
  28. # Revision 1.18  1995/05/18  22:42:25  hartmut
  29. # fixed buf with missing ReplyTo in spooled mails
  30. # removed a tippo
  31. #
  32. # Revision 1.17  1995/05/17  17:14:00  hartmut
  33. # Lists.Owner ist now used (see docs)
  34. # "Errors-To:"-Header is set for all served mails
  35. # all UMSMakeFlags() in loops removed wherever this makes sence
  36. #
  37. # Revision 1.16  1995/05/17  20:29:08  hartmut
  38. # removed superfuous DROP statements
  39. # checked all symbol() calls (arg must be string)
  40. # forgotten to strip comma from user names in lists
  41. # user names are stripped in CheckAcces(), too
  42. # changed do w/ leave into do until/while where possible
  43. # reworked SAY msgs in WriteUserMail()
  44. # cosmetics, esp. Tailer (which was unreadable for humans)
  45. # speedup: some UMSMakeFlags() in loops removed
  46. #
  47. # Revision 1.15  1995/05/09  21:44:28  kai
  48. # fixed unbalanced parentheses Line 1075
  49. # fixed dupecheck for received mail in server mode
  50. #
  51. # Revision 1.14  1995/05/03  18:20:02  kai
  52. # hG cosmetics
  53. # fixed hG bugs
  54. #
  55. # Revision 1.13  1995/05/01  21:04:49  kai
  56. # NODEAMONACCOUNT also for server
  57. # fixed hG's bug which forgot last user of a mailinglist
  58. #
  59. # Revision 1.12  1995/05/01  19:00:46  kai
  60. # removed server command FAQ [hG]
  61. # command WHICH implemented (simple version) [hG]
  62. # majordomo aliases for other commands [hG]
  63. # List.users must only contain 1 comma [hG]
  64. # chars $00..$1F, $80..$9F and "," in usernames are converted to spaces [hG]
  65. # only changed parts of config are written now [hG]
  66. # reads configvars ProgramName.ListName.(Status|Password|Owners|Files) [hG]
  67. # new routines: AddTo/RemFromAddrList(), Write(Changed)Var() [hG]
  68. # new routines: Str2AddrList(), AddrList2Str() [hG]
  69. # ShowConfig(): sorted by Clients/Servers [hG]
  70. # news are selected correctly again [hG]
  71. #
  72. # Revision 1.11  1995/04/30  15:45:30  kai
  73. # changed log levels
  74. # misc cosmetic changes
  75. #
  76. # Revision 1.10  1995/04/28  18:43:51  kai
  77. # cosmetic and documentation changes
  78. # added UMSExportedMsg() and UMSCannotExport()
  79. #
  80. # Revision 1.9  1995/04/28  18:09:06  kai
  81. # lots of clean up, structuring, etc. [hG]
  82. # cosmetic changes and speed-up changes [hG]
  83. # marked places todo 'todo' [hG]
  84. # marked open questions '???' [hG]
  85. # new routines FindUser(), FindList() [hG]
  86. # new routines ProcessCrtlMsg(), ProcessCommand() [hG]
  87. # new routines SendNotification(), SendAdminMail(), SendListMail() [hG]
  88. # new routines DupeCheck() (only used in server part) [hG]
  89. # only those config-vars are written which can be changed via ListManager [hG]
  90. # moved code doublications into subroutines [hG]
  91. # removed .COUNT compout variable, called .0 now [hG]
  92. # (this has some advantages) [hG]
  93. # checked nearly all EXPOSEd variables in Server-Part [hG]
  94. # cosmetics
  95. # changed documentation
  96. # removed time() date()
  97. # fixed parked flag bug with missing comma
  98. #
  99. # Revision 1.8  1995/04/24  22:13:36  kai
  100. # cosmetic changes
  101. # converted some "say" to log()
  102. #
  103. # Revision 1.7  1995/04/23  22:02:38  kai
  104. # changed BIT/K/N to NODEAMONACCOUNT (handles flags.user)
  105. # fixed bug with INDEX which also showed client lists
  106. # added "PARKED" support
  107. # changed flags used for dupe check
  108. # don't write .server and .hostname any more
  109. # fixed other bugs with WriteConfig()
  110. # several small changes I don't remember
  111. #
  112. # Revision 1.6  1995/04/14  17:31:42  kai
  113. # changed say to log()
  114. #
  115. # Revision 1.5  1995/04/12  19:57:12  kai
  116. # fixed Bug when forwarding article to list (as client)
  117. #
  118. # Revision 1.4  1995/04/12  19:52:43  kai
  119. # hG's changes and addition "iterate" in ProcessLists()
  120. #
  121. # Revision 1.3  1995/04/10  14:45:31  hG
  122. # 'exported' notes are logged with level 5+(numMsg=0)
  123. # changed list name parsing
  124. # cosmetics/qualities
  125. # Revision 1.2  1995/04/07  15:20:48  kai
  126. # removed <oid> in server code
  127. # added dupe check in server code
  128. #
  129. # Revision 1.1  1995/04/07  14:46:59  kai
  130. # Initial revision
  131. #
  132. ------------------------------------------------------------------------ */
  133. /*
  134.   Config structure:
  135.  
  136.   global config:
  137.   *Lists.Owner      human owner of the ListServer (account name)
  138.   *Lists.Server     ListServer Deamon (account name)
  139.   *Lists.Hostname   name of this host, used for msg tailers / replyaddr
  140.   *Lists.Address    email address (only if there's no deamon account)
  141.   *Lists.Helpfile
  142.    Lists.Mailinglists   name "," addr         ---> besser group "," name "," addr ???
  143.  
  144.     * means: same name in config-file. Just prefix changed to ProgramName
  145.  
  146.   per-list configuration
  147.   *Lists.XXX.descfile
  148.   *Lists.XXX.group
  149.   *Lists.XXX.alias
  150.   *Lists.XXX.access
  151.   -Lists.XXX.Users
  152.   -Lists.XXX.Owners     (read but not yet used)
  153.   *Lists.XXX.Password   (read but not yet used)
  154.   *Lists.XXX.Status     (read but not yet used)
  155.  
  156.    Lists.Status          m: list of mailinglists changed
  157.    Lists.XXX.Status      Format:  status (upper) "#" changed config vars (lower)
  158.                          status:  C: closed, subscribe must be approved
  159.                                   P: private, only subscribers can write
  160.                                   M: moderated
  161.                                   D: digest
  162.                          changed: u: list of users
  163.                                   o: list of owners
  164.                                   p: password
  165.                                   s: status (first part only)
  166.  
  167.    Lists.0               nof mailinglists
  168.    Lists.XXX.name
  169.    Lists.XXX.addr
  170.  
  171.    Users and Owners go into Lists (NAME is the list's name (MAIL for Users))
  172.  
  173.    Lists.XXX.NAME.0          nof entries
  174.    Lists.XXX.NAME.YYY.name   entry name
  175.    Lists.XXX.NAME.YYY.addr   entry addr
  176.  
  177.     *: same name in config-file, but 'Lists.XXX' changed to 'ProgamName.ListName'
  178.     -: Only in config-file. parsed into stems 'Lists.XXX.foo.YYY' when reading
  179. */
  180.  
  181. options results
  182. options failat 20
  183.  
  184. /*** Startup ***/
  185.  
  186. signal on BREAK_C
  187. signal on BREAK_D
  188. signal on BREAK_E
  189. signal on BREAK_F
  190. signal on ERROR
  191. signal on HALT
  192. signal on IOERR
  193. signal on SYNTAX
  194.  
  195. call addlib('ums.library', 0, -210, 11)
  196. call addlib('rexxdossupport.library', 0, -30, 1)
  197.  
  198. call UMSInitConsts()
  199.  
  200. parse arg arguments
  201. ProgramName = "ListManager";
  202. ArgsTemplate = "NAME,PASSWORD,SERVER/K,NODEAMONACCOUNT/S,LOOP/K,DEBUGLEVEL/N/K"
  203. args.name = "lists"
  204. args.password = ""
  205. args.server = ""
  206. args.nodeamonaccount = 0
  207. args.loop = ""
  208. args.debuglevel = 5
  209.  
  210. if strip(arguments) = '?' then do
  211.   call writech(STDOUT, ArgsTemplate': ')
  212.   arguments = readln(STDIN)
  213. end; else nop
  214. if ~ReadArgs(arguments,ArgsTemplate,"args.") then do
  215.   say Fault(RC,ProgramName)
  216.   exit 10
  217. end; else nop
  218.  
  219. drop arguments
  220.  
  221. /*** Login ***/
  222.  
  223. account = UMSLogin(args.name, args.password, args.server)
  224. if account = 0 then do
  225.   say "unable to login."
  226.   exit 20
  227. end
  228.  
  229. /*** Main ***/
  230.  
  231. GroupPrefix = "mailinglist."
  232.  
  233. if args.nodeamonaccount then do
  234.   args.bit = FindFlag()
  235. end; else do
  236.   args.bit = UMSUSTAT_Old
  237. end
  238.  
  239. call log(7,"startup")
  240.  
  241. err = ReadConfig();
  242. if err ~=" " then do /* ??? */
  243.   call log(2,"cannot read configuration variable '"ProgramName"."err"'.")
  244.   skip HALT
  245. end; else do
  246.   if lists.0 = 0 then do
  247.     call log(4,"nothing to do, no mailinglists defined")
  248.     skip HALT
  249.   end
  250.  
  251.   do forever
  252.     if lists.server ~= "" then do
  253.       call ProcessLists()
  254.     end
  255.     do i = 1 to lists.0
  256.       if lists.i.addr ~= "" then do
  257.         call Export(lists.i.name,lists.i.addr)
  258.       end
  259.     end
  260.     call Import()
  261.  
  262.     if args.loop = "" then leave
  263.     address command args.loop
  264.   end
  265. end
  266.  
  267. call log(7,"done")
  268.  
  269. /*** Final cleanup ***/
  270.  
  271. BREAK_C:
  272. BREAK_D:
  273. BREAK_E:
  274. BREAK_F:
  275. HALT:
  276.  
  277. RC = 0
  278.  
  279. ERROR:
  280. IOERR:
  281. SYNTAX:
  282.  
  283. IF RC ~= 0 THEN DO
  284.   SAY "Error: " rc errortext(rc) "Line" sigl
  285. END
  286.  
  287. /*** Logout ***/
  288.  
  289. if account ~= 0 then do
  290.   call UMSLogout(account)
  291.   account = 0
  292. end
  293.  
  294. exit
  295.  
  296. /*** Check for new messages from the server ***/
  297.  
  298. Import: PROCEDURE expose account GroupPrefix args. lists. ProgramName
  299.  
  300.   call UMSInitConsts()
  301.   f_012 = UMSMakeFlags(0,1,2);
  302.   f_E = UMSMakeFlags(14); f_F = UMSMakeFlags(15);
  303.   f_EF = UMSMakeFlags(14,15)
  304.   f_X = UMSMakeFlags();
  305.   f_OldJunk = UMSMakeFlags(UMSUSTAT_Old,UMSUSTAT_Junk);
  306.  
  307.   call log(7,"moving messages from all lists into groups")
  308.  
  309.   call UMSSelectFlags(account, "L", f_X, f_012,,, "L", f_X, f_X)
  310.  
  311.   call UMSSelectField(account, "L", UMSMakeFlags(0), f_X,,, UMSCODE_Group, "", true)
  312.   call UMSSelectFlags(account, "L", UMSMakeFlags(1), f_X,,, "U", UMSMakeFlags(UMSUSTAT_ReadAccess, UMSUSTAT_Old), UMSMakeFlags(UMSUSTAT_ReadAccess))
  313.   call UMSSelectFlags(account, "L", UMSMakeFlags(2), f_X,,, "G", UMSMakeFlags(UMSGSTAT_Parked), f_X)
  314.  
  315.   last = 0; numMsgs = 0;
  316.   do forever
  317.     last = UMSSearchFlags(account, "L", f_012, f_012, last)
  318.     if last = 0 then leave
  319.  
  320.     drop msg.
  321.     if UMSReadMsgField(account, last, msg., UMSCODE_ReplyName, TRUE) then do
  322.       parse var msg.UMSCODE_ReplyName test "'" listname "'"
  323.       if (upper(test) = "MAILINGLIST ") & (listname ~= "") & ~FindServedList(listname) then do
  324.  
  325.         if ~UMSReadMsgAll(account, last, msg., TRUE) then do
  326.           call CheckErr
  327.           /* workaround for ARexx bug with msgs >64kB */
  328.           call UMSSelectMsg(account,"U", f_X, UMSMakeFlags(UMSUSTAT_Old), last)
  329.           iterate
  330.         end
  331.  
  332.         /* insert into config var, if not already there */
  333.         call CheckEntry(listname,msg.UMSCODE_ReplyAddr)
  334.  
  335.         msg.UMSCODE_Group = GroupPrefix || listname
  336.         drop msg.UMSCODE_ToName msg.UMSCODE_ToAddr
  337.         drop msg.UMSCODE_ReplyName msg.UMSCODE_ReplyAddr msg.UMSCODE_Folder
  338.  
  339.         msg.SOFTLINK = last
  340.         msg.NOUPDATE = args.nodeamonaccount
  341.         drop msg.UMSCODE_Comments
  342.  
  343.         /* DupeCheck */
  344.         call UMSSelectFlags(account, "L", f_X, f_EF,,, "L", f_X, f_X)
  345.         call UMSSelectField(account, "L", f_F, f_X,,, UMSCODE_Group, msg.UMSCODE_Group, TRUE)
  346.         call UMSSelectField(account, "L", f_E, f_X,,, UMSCODE_MsgID, msg.UMSCODE_MsgID, TRUE)
  347.  
  348.         if UMSSearchFlags(account, "L", f_EF, f_EF) = 0 then do
  349.           num = UMSWriteMsg(account, msg.)
  350.           if num = 0 then do
  351.             call CheckErr
  352.           end; else do
  353.             call UMSSelectMsg(account,"U", f_OldJunk, f_X, last)
  354.             call UMSSelectMsg(account,"U", UMSMakeFlags(args.bit), f_X, num)
  355.  
  356.             numMsgs = numMsgs + 1;
  357.             call log(8,"forwarded message written by '"msg.UMSCODE_FromName"' to '"msg.UMSCODE_Group"'")
  358.           end
  359.         end; else do
  360.           call UMSSelectMsg(account,"U", f_OldJunk, f_X, last)
  361.           call log(2,"rejected dupe <"msg.UMSCODE_MsgID"> written by '"msg.UMSCODE_FromName ||,
  362.                      "' intended for '"msg.UMSCODE_Group"'")
  363.         end
  364.       end
  365.     end; else call CheckErr
  366.   end
  367.   call log(6+(numMsgs=0),"imported" numMsgs "messages");
  368. return
  369.  
  370. /*** Check for new messages from the users ***/
  371.  
  372. Export: PROCEDURE Expose account GroupPrefix ProgramName args.
  373.   listname=arg(1); listaddr = arg(2);
  374.  
  375.   call UMSInitConsts()
  376.   f_012 = UMSMakeFlags(0,1,2);
  377.   f_E = UMSMakeFlags(14); f_F = UMSMakeFlags(15);
  378.   f_EF = UMSMakeFlags(14,15)
  379.   f_X = UMSMakeFlags();
  380.   f_Old = UMSMakeFlags(UMSUSTAT_Old); f_Junk = UMSMakeFlags(UMSUSTAT_Junk);
  381.   f_Bit = UMSMakeFlags(args.bit);
  382.  
  383.   groupname = GroupPrefix || listname
  384.  
  385.   call UMSSelectFlags(account, "L", f_X,  f_012  ,,, "L", f_X, f_X);
  386.  
  387.   call UMSSelectField(account, "L", UMSMakeFlags(0), f_X,,, UMSCODE_Group, groupname, TRUE)
  388.   call UMSSelectFlags(account, "L", UMSMakeFlags(1), f_X,,, "U", UMSMakeFlags(UMSUSTAT_ReadAccess, args.bit), UMSMakeFlags(UMSUSTAT_ReadAccess))
  389.   call UMSSelectFlags(account, "L", UMSMakeFlags(2), f_X,,, "G", UMSMakeFlags(UMSGSTAT_Parked), f_X)
  390.  
  391.   last = 0; numMsgs = 0;
  392.   do forever
  393.     last = UMSSearchFlags(account, "L", f_012, f_012, last)
  394.     if last = 0 then leave
  395.     drop msg.
  396.     if ~UMSReadMsgAll(account, last, msg., TRUE) then do
  397.       call CheckErr
  398.       /* workaround for ARexx bug with msgs >64kB */
  399.       call UMSSelectMsg(account,"U", f_X, f_Old, last)
  400.       iterate
  401.     end
  402.  
  403.     drop msg.UMSCODE_Group msg.UMSCODE_Comments
  404.     msg.SOFTLINK = last
  405.     msg.UMSCODE_ToName = "Mailinglist '"listname"'"
  406.     if listaddr ~= "" then
  407.       msg.UMSCODE_ToAddr = listaddr
  408.     else
  409.       drop msg.UMSCODE_ToAddr
  410.  
  411.     /* Dupe Check */
  412.     call UMSSelectFlags(account, "L", f_X, f_EF,,, "L", f_X, f_X)
  413.     call UMSSelectField(account, "L", f_F, f_X,,, UMSCODE_Group, "", TRUE)
  414.     call UMSSelectField(account, "L", f_E, f_X,,, UMSCODE_MsgID, msg.UMSCODE_MsgID, TRUE)
  415.  
  416.     if UMSSearchFlags(account, "L", f_EF, f_EF) = 0 then do
  417.       num = UMSWriteMsg(account, msg.)
  418.       if num = 0 then
  419.         call CheckErr
  420.       else do
  421.         call UMSSelectMsg(account,"U", f_Junk, f_X, num)
  422.         call UMSSelectMsg(account,"U", f_bit, f_X, last)
  423.         call UMSExportedMsg(account,last)
  424.  
  425.         numMsgs = numMsgs + 1;
  426.         call log(8,"forwarded message written by '"msg.UMSCODE_FromName"' from '"groupname"'")
  427.       end
  428.     end; else do
  429.       call UMSSelectMsg(account,"U", f_bit, f_X, last)
  430.       logtxt = "rejected dupe <"msg.UMSCODE_MsgID"> written by '"msg.UMSCODE_FromName || "' in '"groupname"'"
  431.       call log(2,logtxt)
  432.       call UMSCannotExport(account,last,logtxt)
  433.       /* drop logtxt superfluous */
  434.     end
  435.   end
  436.   call log(6+(numMsgs=0),"exported" numMsgs "messages to list '"listname"'");
  437. return
  438.  
  439. /*** check if mailinglist is in our list ***/
  440.  
  441. CheckEntry: /*PROCEDURE expose Lists. and everyhing for WriteConfig */
  442.   listname=arg(1); listaddr=arg(2);
  443.   i = FindClientList(listname);
  444.   if i > 0 then do
  445.     if upper(lists.i.addr) = upper(listaddr) then do
  446.       return true
  447.     end; else do
  448.       /* address changed */
  449.       lists.i.addr = listaddr
  450.     end
  451.   end; else do
  452.     i = lists.0 +1 /* lists.0 is index and count */
  453.     lists.i.name = listname
  454.     lists.i.addr = listaddr
  455.     lists.0 = i
  456.   end
  457.   lists.status = lists.status || "m"
  458. return WriteConfig()
  459.  
  460. /*** Show a message for debugging ***/
  461.  
  462. ShowMsg:
  463.   do field = 0 to UMSNUMFIELDS
  464.     if (symbol("msg."field) = "VAR") & (field ~= UMSCODE_MsgText) & (field ~= UMSCODE_Comments) then do
  465.       say "Field #"field": '"msg.field"'"
  466.     end
  467.   end
  468. return
  469.  
  470. /*** config stuff ***/
  471. /** list support routines **/
  472.  
  473. CheckAccess: PROCEDURE expose lists. true false
  474.   user = translate(arg(1),,","xrange('00'x,'1F'x)||xrange('80'x,'9F'x),); /* hg/04-may-95*/
  475.   string = user","arg(2)
  476.   list = upper(arg(3))
  477.   do i = 1 to lists.0
  478.     if (lists.i.addr = "") & (upper(lists.i.name) = list) then do
  479.       return MatchPattern( lists.i.access, string, "N")
  480.     end
  481.   end
  482. return false
  483.  
  484. FindServedList: PROCEDURE expose Lists.
  485.   searchname = upper(arg(1));
  486.   do i = 1 to lists.0
  487.     if (lists.i.addr = "") then do /* splitted for short curcuit evaluation */
  488.       if (searchname = upper(lists.i.name)) then do
  489.         return i;
  490.       end
  491.     end
  492.   end
  493. return 0;
  494.  
  495. FindClientList: PROCEDURE expose Lists.
  496.   searchname = upper(arg(1));
  497.   do i = 1 to lists.0
  498.     if (lists.i.addr ~= "") then do /* splitted for short curcuit evaluation */
  499.       if (searchname = upper(lists.i.name)) then do
  500.         return i;
  501.       end
  502.     end
  503.   end
  504. return 0;
  505.  
  506. FindInAddrList: PROCEDURE expose Lists.  /*hg/30-Apr-95*/
  507.   user = arg(1); naddr = arg(2); addrList = upper(arg(3)) /* listNum"."mail */
  508.   do j = 1 to lists.addrList.0
  509.     if (lists.addrList.j.name = user) then do /* splitted for short curcuit evaluation */
  510.       if (lists.addrList.j.addr = naddr) then do
  511.         return j;
  512.       end
  513.     end
  514.   end
  515. return 0;
  516.  
  517. AddrList2Str: PROCEDURE expose Lists. /*hg/30-Apr-95*/
  518.   addrList = upper(arg(1)) /* listNum"."mail */
  519.   temp = ""
  520.   do j = 1 to lists.addrList.0
  521.     if j ~= 1 then temp = temp || '0A'x
  522.     temp = temp || lists.addrList.j.name
  523.     if lists.addrList.addr ~= "" then temp = temp","lists.addrList.j.addr
  524.   end
  525. return temp;
  526.  
  527. Str2AddrList: PROCEDURE expose Lists. /*hg/30-Apr-95*/
  528.   addrList = upper(arg(1)) /* listNum"."mail */
  529.   string = arg(2);
  530.   j = 0
  531.   do while string ~= ""
  532.     parse var string usrname "," usraddr '0A'x string
  533.     j = j + 1
  534.     lists.addrList.j.name = strip(usrname)
  535.     lists.addrList.j.addr = strip(usraddr)
  536.   end
  537.   lists.addrList.0 = j
  538. return
  539.  
  540. AddToAddrList: PROCEDURE expose lists. true false /*hg/30-Apr-95*/
  541.   user = arg(1); naddr = arg(2); /* listname = arg(3) */
  542.   mail = upper(arg(4)); /* statusflag = arg(5); */
  543.   i = FindServedList(arg(3));
  544.   if i > 0 then do
  545.     user = translate(user,,","xrange('00'x,'1F'x)||xrange('80'x,'9F'x),);
  546.     j = FindInAddrList(user,naddr,i"."mail)
  547.     if j = 0 then do /* not already in list */
  548.       j = lists.i.mail.0+1
  549.       lists.i.mail.j.name = user
  550.       lists.i.mail.j.addr = naddr
  551.       lists.i.mail.0 = j
  552.       lists.i.status = lists.i.status || arg(5);
  553.     end;
  554.     return true
  555.   end;
  556. return false
  557.  
  558. RemFromAddrList: PROCEDURE expose lists. true false /*hg/30-Apr-95*/
  559.   user = arg(1); naddr = arg(2); /* listname = arg(3) */
  560.   mail = upper(arg(4)); /* statusflag = arg(5); */
  561.   i = FindServedList(arg(3));
  562.   if i > 0 then do
  563.     user = translate(user,,","xrange('00'x,'1F'x)||xrange('80'x,'9F'x),);
  564.     j = FindInAddrList(user,naddr,i"."mail)
  565.     if j ~= 0 then do
  566.       k = lists.i.mail.0;
  567.       if j < k then do
  568.         /* insert last entry at current position */
  569.         lists.i.mail.j.name = lists.i.mail.k.name
  570.         lists.i.mail.j.addr = lists.i.mail.k.addr
  571.       end;
  572.       drop lists.i.mail.k.name
  573.       drop lists.i.mail.k.addr
  574.       lists.i.mail.0 = k-1;
  575.       lists.i.status = lists.i.status || arg(5);
  576.       return true
  577.     end;
  578.   end
  579. return false
  580.  
  581. FindUser: PROCEDURE expose lists. true false
  582.   return FindInAddrList(arg(1),arg(2),arg(3));
  583.  
  584. AddUser: PROCEDURE expose lists. true false
  585.   return AddToAddrList(arg(1),arg(2),arg(3),"MAIL","u");
  586.  
  587. RemUser: PROCEDURE expose lists. true false mail
  588.  return RemFromAddrList(arg(1),arg(2),arg(3),"MAIL","u");
  589.  
  590. AddOwner: PROCEDURE expose lists. true false
  591.   return AddToAddrList(arg(1),arg(2),arg(3),"OWNERS","o");
  592.  
  593. RemOwner: PROCEDURE expose lists. true false mail
  594.   return RemFromAddrList(arg(1),arg(2),arg(3),"OWNERS","o");
  595.  
  596. /** **/
  597.  
  598. SendAdminMail: PROCEDURE expose account lists. args. ProgramName
  599.   /* sends Message with MsgText arg(2) to all owners of list arg(1) */
  600.   name = arg(1); text = arg(2)
  601.   call UMSInitConsts()
  602.   /* drop msg. superfluous */
  603.   /* todo
  604.   msg.UMSCODE_ReplyName = lists.server
  605.   msg.UMSCODE_ReplyAddr = lists.server"@"lists.hostname
  606.   msg.UMSCODE_LogicalToName = "Owners of List '"name"'"
  607.   if ~args.nodeamonaccount then do
  608.     msg.UMSCODE_LogicalToAddr = "listowners"@"lists.hostname
  609.   end
  610.   */
  611.   msg.UMSCODE_MsgText = text;
  612.   msg.UMSCODE_Subject = "ListServer Request"
  613.  
  614.   /*** write mails ***/
  615.   firstnum = 0; newnum = 0;
  616.   if lists.name.owner.0 = 0 then /* no owners defined */
  617.     msg.UMSCODE_ToName = Lists.Owner
  618.     firstnum = UMSWriteMsg(account,msg.)
  619.     if firstnum = 0 then call CheckErr
  620.   end; else
  621.     do j = 1 to lists.name.owners.0
  622.       msg.UMSCODE_ToName = lists.name.owners.j.name
  623.       msg.UMSCODE_ToAddr = lists.name.owners.j.addr
  624.       newnum = UMSWriteMsg(account,msg.)
  625.       if newnum = 0 then do
  626.         call CheckErr
  627.       end; else do
  628.         if firstnum = 0 then firstnum = newnum;
  629.       end
  630.     end
  631.   if newnum ~= firstnum then call log(9,"write admin mail:" firstnum".."newnum)
  632. return
  633.  
  634. ParseCommandArgs: PROCEDURE expose arguments carg. MsgText true false LF
  635.   if ~ReadArgs(arguments,arg(1),"carg.") then do
  636.     MsgText = MsgText || "wrong arguments! Template:" arg(1) ||LF
  637.     return FALSE
  638.   end;
  639. return true;
  640.  
  641. SendNotification: PROCEDURE expose carg. msg. lists. account args. ProgramName
  642.   call UMSInitConsts();
  643.   /* drop notifymsg. superfluous */
  644.   notifymsg.UMSCODE_ToName = carg.name
  645.   notifymsg.UMSCODE_ToAddr = carg.addr
  646.   notifymsg.UMSCODE_RefID  = msg.UMSCODE_MsgID
  647.   notifymsg.UMSCODE_FromName  = lists.server
  648.   notifymsg.UMSCODE_Attributes = "ALIAS" lists.server
  649.   if ~args.nodeamonaccount then do
  650.     notifymsg.UMSCODE_ReplyName = Lists.Owner
  651.   end
  652.   notifymsg.UMSCODE_Subject   = "Listserver notification" /* todo */
  653.   notifymsg.UMSCODE_MsgText = arg(1);
  654.   if UMSWriteMsg(account, notifymsg.) = 0 then call CheckErr
  655. return
  656.  
  657. ProcessCommand: PROCEDURE EXPOSE msg. Lists. LF MsgText account args. ProgramName,
  658.                                  ConfigChanged quit
  659.   /* called from ProcessCtrlMsg */
  660.   command = arg(1); arguments = arg(2);
  661.   call UMSInitConsts();
  662.  
  663.   /* not yet finished    hg/01-may-95
  664.   if command = "APPROVE" then do
  665.     if ~ParseCommandArgs("PASSWORD/A,COMMAND/A,LIST/A,NAME/K,ADDR/K") then
  666.       return false;
  667.     i = FindList(carg.list);
  668.     if i = 0 then do
  669.       MsgText = MsgText || "mailinglist not found"LF
  670.       return false;
  671.     end;
  672.     approved = (cargs.password = lists.i.password);
  673.     command = upper(carg.command);
  674.   end;
  675.   */
  676.  
  677.   select
  678.     when (command = "QUIT") | (command = "STOP") then do
  679.       MsgText = MsgText || "ok, stopped processing you mail"LF
  680.       quit = true
  681.     end
  682.  
  683.     when command = "HELP" then do
  684.       if lists.helpfile = "" then
  685.         MsgText = MsgText || "sorry, no help available"LF
  686.       else
  687.         MsgText = MsgText || Include(lists.helpfile) ||LF
  688.     end
  689.  
  690.     when (command = "USERS") | (command = "WHO") then do
  691.       if ParseCommandArgs("LIST/A") then do
  692.         i = FindList(carg.list);
  693.         if i > 0 then do
  694.           do j = 1 to lists.i.mail.0
  695.              MsgText = MsgText || lists.i.mail.j.name "<"lists.i.mail.j.addr">"LF
  696.           end
  697.         end; else do
  698.           MsgText = MsgText || "mailinglist not found"LF
  699.         end
  700.       end
  701.     end
  702.  
  703.     when (command = "INDEX") | (command = "LISTS") then do
  704.       do i = 1 to lists.0
  705.         if lists.i.addr = "" then
  706.           MsgText = MsgText || lists.i.name ||LF
  707.       end
  708.     end
  709.  
  710.     when command = "WHICH" then do /**hg/01-may-95*/
  711.       do i = 1 to lists.0
  712.         if lists.i.addr = "" then
  713.           if FindUser(msg.UMSCODE_FromName,msg.UMSCODE_FromAddr,lists.i.addr) > 0 then
  714.             MsgText = MsgText || "    "lists.i.name ||LF
  715.       end
  716.     end
  717.  
  718.     when (command = "ADD") | (command = "SUBSCRIBE")  then do
  719.       carg.name = msg.UMSCODE_FromName;
  720.       carg.addr = msg.UMSCODE_FromAddr;
  721.       if ParseCommandArgs("LIST/A,NAME/K,ADDR/K") then do
  722.         if ~CheckAccess(msg.UMSCODE_FromName,msg.UMSCODE_FromAddr,carg.list) then do
  723.           MsgText = MsgText || 'Mailinglist "'carg.list '"is private, ask the postmaster'LF /* todo */
  724.         end; else do
  725.           if AddUser(carg.name, carg.addr, carg.list) then do
  726.             configChanged = true
  727.             MsgText = MsgText || "added" carg.name "<"carg.addr'> to mailinglist "'carg.list'"'LF
  728.             if (carg.name ~= msg.UMSCODE_FromName) | (carg.addr ~= msg.UMSCODE_FromAddr) then do
  729.               call SendNotification("You have been added to the mailinglist '"carg.list"' by"LF||,
  730.                                     msg.UMSCODE_FromName "<"msg.UMSCODE_FromAddr">"LF);
  731.             end
  732.           end; else do
  733.             MsgText = MsgText || "error, not added"LF /* todo */
  734.           end
  735.         end
  736.       end
  737.     end
  738.  
  739.     when (command = "DELETE") | (command = "REMOVE") | (command = "UNSUBSCRIBE") then do
  740.       carg.name = msg.UMSCODE_FromName;
  741.       carg.addr = msg.UMSCODE_FromAddr;
  742.       if ParseCommandArgs("LIST/A,NAME/K,ADDR/K") then do
  743.         if RemUser(carg.name, carg.addr, carg.list) then do
  744.           configChanged = true
  745.           MsgText = MsgText || "removed" carg.name "<"carg.addr'> from mailinglist "'carg.list'"'LF
  746.           if (carg.name ~= msg.UMSCODE_FromName) | (carg.addr ~= msg.UMSCODE_FromAddr) then do
  747.             call SendNotification("You have been removed from the mailinglist '"carg.list"' by"LF||,
  748.                                   msg.UMSCODE_FromName "<"msg.UMSCODE_FromAddr">"LF)
  749.           end
  750.         end; else do
  751.           MsgText = MsgText || "error, not removed"LF /* todo */
  752.         end
  753.       end
  754.     end
  755.  
  756.     when (command = "DESCRIPTION") | (command = "DESC") | (command = "INFO") then do /*hg/30-Apr-95*/
  757.       if ParseCommandArgs("LIST/A") then do
  758.         i = FindList(carg.list);
  759.         if i > 0 then do
  760.           if lists.i.descfile = "" then do
  761.             MsgText = MsgText || "sorry, no description available for this list"LF
  762.           end; else do
  763.             MsgText = MsgText || Include(lists.i.descfile) ||LF
  764.           end
  765.         end; else do
  766.           MsgText = MsgText || "mailinglist not found"LF
  767.         end
  768.       end
  769.     end
  770.  
  771.     otherwise do
  772.       MsgText = MsgText || "unknown command"LF
  773.       RETURN FALSE
  774.     end
  775.   END;  /* select */
  776. RETURN true
  777.  
  778. ProcessCtrlMsg: PROCEDURE Expose account Lists. ConfigChanged args. ProgramName
  779.   call UMSInitConsts();
  780.   curmsg = arg(1); LF = '0A'x;
  781.   /* drop msg. superfluous */
  782.   if ~UMSReadMsgAll(account, curmsg, msg., TRUE) then do
  783.     call CheckErr
  784.     /* workaround for ARexx bug with msgs >64kB */
  785.     call UMSSelectMsg(account,"U", UMSMakeFlags(), UMSMakeFlags(UMSUSTAT_Old), curmsg)
  786.   end; else do
  787.     if symbol("msg."UMSCODE_FromAddr) ~= "VAR" then msg.UMSCODE_FromAddr = ""
  788.  
  789.     MsgText   = "Listserver startup"LF
  790.     validcommand = false; quit = false;
  791.     do while (msg.UMSCODE_MsgText ~= "") & ~quit
  792.       parse var msg.UMSCODE_MsgText command '0A'x msg.UMSCODE_msgText
  793.       command = strip(command)
  794.       if command ~= "" then do
  795.         parse var command command " " arguments
  796.         upper command
  797.         MsgText = MsgText || LF ">" command arguments ||LF||LF
  798.  
  799.         validcommand = ProcessCommand(command,arguments) | validCommand;
  800.       end
  801.     end
  802.  
  803.     MsgText = MsgText ||LF
  804.     if ~validcommand then do
  805.       MsgText = MsgText ||LF|| "There was no valid command in this message. Here's some help:"LF ,
  806.                 || Include(lists.helpfile) ||LF
  807.     end
  808.  
  809.     /*** done, send the logfile ***/
  810.     /* drop newmsg.  superfluous */
  811.     if symbol("msg."UMSCODE_ReplyName) ~= "VAR" then do
  812.       newmsg.UMSCODE_ToName = msg.UMSCODE_FromName
  813.       newmsg.UMSCODE_ToAddr = msg.UMSCODE_FromAddr
  814.     end; else do
  815.       newmsg.UMSCODE_ToName = msg.UMSCODE_ReplyName
  816.       if symbol("msg."UMSCODE_ReplyAddr) = "VAR" then do
  817.         newmsg.UMSCODE_ToAddr = msg.UMSCODE_ReplyAddr
  818.       end
  819.     end
  820.     newmsg.UMSCODE_RefID     = msg.UMSCODE_MsgID
  821.     newmsg.UMSCODE_FromName  = Lists.Server
  822.     if ~args.nodeamonaccount then do
  823.       newmsg.UMSCODE_ReplyName = Lists.Owner
  824.     end
  825.     newmsg.UMSCODE_Subject   = "Listserver logfile" /* todo */
  826.     newmsg.UMSCODE_MsgText = MsgText
  827.     if UMSWriteMsg(account, newmsg.) = 0 then call CheckErr
  828.     call UMSSelectMsg(account,"U", UMSMakeFlags(UMSUSTAT_Old), UMSMakeFlags(), curmsg)
  829.   end;
  830. return
  831.  
  832. ReadConfig: PROCEDURE expose lists. args. ProgramName account TRUE FALSE
  833.   lists.status = "";
  834.   temp = UMSReadConfig(account, ProgramName".MailingLists")
  835.   if temp = "" then return "MailingLists"
  836.   i = 0
  837.   do while temp ~= ""
  838.     i = i + 1
  839.     parse var temp lists.i.name "," lists.i.addr '0A'x temp
  840.     lists.i.name = strip(lists.i.name);
  841.     lists.i.addr = strip(lists.i.addr)
  842.   end
  843.   lists.0 = i;
  844.  
  845.   /* global config */
  846.   lists.server = UMSReadConfig(account, ProgramName".Server")
  847.   if lists.server ~= "" then do
  848.     if args.nodeamonaccount then do
  849.       lists.address = UMSReadConfig(account, ProgramName".Address")
  850.       if lists.address = "" then return ".Address"
  851.     end; else do
  852.       lists.hostname = UMSReadConfig(account, ProgramName".Hostname")
  853.       if lists.helpfile = "" then return ".Hostname"
  854.     end
  855.     Lists.Owner = UMSReadConfig(account, ProgramName".Owner")
  856.     if Lists.Owner = "" then Lists.Owner = "postmaster"
  857.     lists.helpfile = UMSReadConfig(account, ProgramName".Helpfile")
  858.   end;
  859.  
  860.   /* per list config */
  861.   do i = 1 to lists.0
  862.     if lists.i.addr = "" then do
  863.       if lists.server = "" then return ".Server"
  864.       lists.i.group = UMSReadConfig(account, ProgramName"."lists.i.name".group")
  865.       if lists.i.group = "" then return lists.i.name".group"
  866.       lists.i.status = UMSReadConfig(account, ProgramName"."lists.i.name".status")
  867.       lists.i.status = lists.i.status || "#" /*delemitter */
  868.       lists.i.descfile = UMSReadConfig(account, ProgramName"."lists.i.name".descfile")
  869.       lists.i.access = UMSReadConfig(account, ProgramName"."lists.i.name".access")
  870.       lists.i.alias = UMSReadConfig(account, ProgramName"."lists.i.name".alias")
  871.       temp = UMSReadConfig(account, ProgramName"."lists.i.name".users")
  872.       if temp = "" then return lists.i.name".users"
  873.       call Str2AddrList(i".MAIL", temp);
  874.       temp = UMSReadConfig(account, ProgramName"."lists.i.name".owners")
  875.       call Str2AddrList(i".OWNER", temp);
  876.     end
  877.   end
  878. return " "
  879.  
  880. WriteVar: PROCEDURE expose lists. args. ProgramName account TRUE FALSE
  881.   varname = upper(arg(1)); contents = arg(2);
  882.   if contents ~= "" then do
  883.     call UMSWriteConfig(account, ProgramName"."varname, contents, args.name,)
  884.     call checkerr()
  885.   end
  886. return
  887.  
  888. WriteChangedVar: PROCEDURE expose lists. i args. ProgramName account TRUE FALSE
  889.   varname = upper(arg(1)); contents = arg(2);
  890.   if pos(arg(3),lists.i.status) ~= 0 then do
  891.     call UMSWriteConfig(account, ProgramName"."varname, contents, args.name,)
  892.     call checkerr()
  893.   end
  894. return
  895.  
  896. WriteConfig: PROCEDURE expose lists. args. ProgramName account TRUE FALSE
  897.   /* global config is never written, why should it?
  898.   if lists.server ~= "" then do
  899.     call WriteVar("server", lists.server)
  900.     if args.nodeamonaccount then do
  901.       call WriteVar("address", lists.address)
  902.     end; else do
  903.       call WriteVar("hostname", lists.hostname)
  904.     end
  905.     call WriteVar("Owner", lists.Owner)
  906.     call WriteVar("helpfile", lists.helpfile)
  907.   end
  908.   */
  909.  
  910.   ltemp = ""
  911.   do i = 1 to lists.0
  912.     if i ~= 1 then ltemp = ltemp || '0A'x
  913.     ltemp = ltemp || lists.i.name","lists.i.addr
  914.     if lists.i.addr = "" then do /* served here */
  915.       temp = AddrList2Str(i".MAIL");
  916.       call WriteChangedVar(lists.i.name".Users", temp, "u");
  917.       /* this may only be changed by the postmaster, so why write it?
  918.       call WriteVar(lists.i.name".group", lists.i.group);
  919.       call WriteVar(lists.i.name".descfile", lists.i.descfile);
  920.       call WriteVar(lists.i.name".alias", lists.i.alias);
  921.       */
  922.       /* this part schould become maintainable via mail
  923.       temp = AddrList2Str(i".OWNER");
  924.       call WriteChangedVar(lists.i.name".Owners", temp, "o");
  925.       parse var lists.i.status temp "#" .
  926.       call WriteChangedVar(lists.i.name".Status", temp, "s");
  927.       call WriteChangedVar(lists.i.name".Password", lists.i.password, "p");
  928.       */
  929.     end
  930.   end
  931.   i = pos("m",lists.status);
  932.   if i ~= 0 then do /* write only if changed */
  933.     call WriteVar("Mailinglists", ltemp);
  934.     lists.status = delstr(lists.status,i,1); /*due to CheckEntry() */
  935.   end;
  936. return TRUE
  937.  
  938. ShowListConfig: PROCEDURE expose Lists.
  939.   addrList = upper(arg(1));
  940.   do j = 1 to lists.addrList.0
  941.     say "        " lists.addrList.j.name lists.addrList.j.addr
  942.   end
  943. return
  944.  
  945. ShowConfig: PROCEDURE expose lists.
  946.   say "Managing" lists.0 "lists!" || '0A'x
  947.   do i = 1 to lists.0
  948.     if lists.i.addr ~= "" then say "Client:" lists.i.name lists.i.addr
  949.   end
  950.   say ""
  951.   do i = 1 to lists.0
  952.     if lists.i.addr = "" then do
  953.       say "Server: " lists.i.name
  954.       call ShowListConfig(i".MAIL");
  955.       say "Owners:"; call ShowListConfig(i".OWNER");
  956.       say
  957.     end
  958.   end
  959. return
  960.  
  961. /*** ProcessLists ***/
  962.  
  963. DupeCheck:
  964.   call UMSSelectFlags(account, "L", f_X, f_CDEF,,, "L", f_X, f_X)
  965.   call UMSSelectField(account, "L", f_F, f_X,,, UMSCODE_Group, "", TRUE)
  966.   call UMSSelectField(account, "L", f_E, f_X,,, UMSCODE_ToName, msg.UMSCODE_ToName, TRUE)
  967.   call UMSSelectField(account, "L", f_D, f_X,,, UMSCODE_ToAddr, msg.UMSCODE_ToAddr, TRUE)
  968.   call UMSSelectField(account, "L", f_C, f_X,,, UMSCODE_MsgID, msg.UMSCODE_MsgID, TRUE)
  969.  
  970.   if UMSSearchFlags(account, "L", f_CDEF, f_CDEF) ~= 0 then do
  971.     logtxt = "rejected dupe <"msg.UMSCODE_MsgID"> written by '"msg.UMSCODE_FromName || "' intended to <"msg.UMSCODE_ToAddr">"
  972.     call log(2,logtxt)
  973.     call UMSCannotExport(account,curmsg,logtxt)
  974.     /* drop logtxt superfluous */
  975.     return false
  976.   end
  977. RETURN TRUE
  978.  
  979. SendListMails:
  980.   /* set up mail hdr */
  981.   msg.UMSCODE_ReplyName = longname
  982.   msg.UMSCODE_LogicalToName = longname
  983.   if ~args.nodeamonaccount then do
  984.     msg.UMSCODE_ReplyAddr = shortname"@"lists.hostname
  985.     msg.UMSCODE_LogicalToAddr = shortname"@"lists.hostname
  986.     msg.UMSCODE_RfcAttr = '"Errors-To:' lists.owner'@'lists.hostname'"'
  987.   end
  988.   if symbol("msg."UMSCODE_MsgText) ~= "VAR" then msg.UMSCODE_MsgText = ""
  989.   msg.UMSCODE_MsgText = msg.UMSCODE_MsgText || Tailer
  990.   drop msg.UMSCODE_Group
  991.  
  992.   /* write mails */
  993.   lognum = 0;
  994.   do j = 1 to lists.i.mail.0
  995.     msg.UMSCODE_ToName = lists.i.mail.j.name
  996.     msg.UMSCODE_ToAddr = lists.i.mail.j.addr
  997.     if (msg.UMSCODE_ToName ~= msg.UMSCODE_fromName),
  998.     | (msg.UMSCODE_ToAddr ~= msg.UMSCODE_fromAddr) then do
  999.       if DupeCheck() then do
  1000.         newnum = UMSWriteMsg(account,msg.)
  1001.         if newnum = 0 then do
  1002.           call CheckErr
  1003.           call UMSCannotExport(account,curmsg,"problems with UMSWriteMsg()")
  1004.         end; else do
  1005.           call UMSSelectMsg(account,"U", f_Junk, f_X, newnum)
  1006.           call UMSExportedMsg(account,curmsg)
  1007.           if lognum = 0 then lognum = newnum
  1008.         end
  1009.       end
  1010.     end
  1011.   end
  1012.   if lognum ~= 0 then call log(9,"write mail:" lognum".."newnum)
  1013. return
  1014.  
  1015. ProcessLists: procedure expose account lists. args. ProgramName account TRUE FALSE
  1016.   call UMSInitConsts(); LF = '0A'x;
  1017.  
  1018.   l_new  = UMSMakeFlags(0)
  1019.   l_notp = UMSMakeFlags(1)
  1020.   l_priv = UMSMakeFlags(2)
  1021.   l_name = UMSMakeFlags(3)
  1022.   l_group = UMSMakeFlags(4)
  1023.   if args.nodeamonaccount then l_bit  = UMSMakeFlags(10) /* kai hopes this is free */
  1024.                           else l_bit  = l_new
  1025.   l_newmail = BITOR(l_new,BITOR(l_priv,l_notp));
  1026.   l_newlist = BITOR(l_newmail,l_name)
  1027.   l_newnews = BITOR(l_bit,BITOR(l_notp,l_group))
  1028.   f_X = UMSMakeFlags();
  1029.   f_C = UMSMakeFlags(12); f_D = UMSMakeFlags(13);
  1030.   f_E = UMSMakeFlags(14); f_F = UMSMakeFlags(15);
  1031.   f_EF = UMSMakeFlags(14,15); f_CDEF = UMSMakeFlags(12,13,14,15);
  1032.   f_Junk = UMSMakeFlags(UMSUSTAT_Junk); f_old = UMSMakeFlags(UMSUSTAT_Old)
  1033.   f_Bit = UMSMakeFlags(args.bit);
  1034.  
  1035.   call UMSSelectFlags(account,"L",,l_new,,,"L",l_new,l_new)
  1036.   call UMSSelectFlags(account,"L",l_new,,,,"U",UMSMakeFlags(UMSUSTAT_Old, UMSUSTAT_ReadAccess, UMSUSTAT_ViewAccess),UMSMakeFlags(UMSUSTAT_ReadAccess, UMSUSTAT_ViewAccess))
  1037.   if args.nodeamonaccount then do
  1038.     call UMSSelectFlags(account,"L",,l_bit,,,"L",l_bit,l_bit)
  1039.     call UMSSelectFlags(account,"L",l_bit,,,,"U",UMSMakeFlags(args.bit, UMSUSTAT_ReadAccess, UMSUSTAT_ViewAccess),UMSMakeFlags(UMSUSTAT_ReadAccess, UMSUSTAT_ViewAccess))
  1040.   end
  1041.   call UMSSelectFlags(account,"L",l_notp,,,,"G",UMSMakeFlags(UMSGSTAT_Parked), f_X)
  1042.   call UMSSelectField(account,"L",l_priv,,,,UMSCODE_Group,"",true)
  1043.  
  1044.   num = UMSSelectFlags(account,"L",,,,,"L",l_newmail,l_newmail)
  1045.   call log(7,"new mails overall:" num)
  1046.  
  1047.   /*** process received control mails ***/
  1048.  
  1049.   call log(7,"Processing control mails:")
  1050.  
  1051.   call UMSSelectFlags(account,"L",,l_name,,,"L",l_name,l_name)
  1052.   call UMSSelectField(account,"L",l_name,,,,UMSCODE_ToName,lists.server)
  1053.  
  1054.   call log(7,"new mail for <"lists.server">:",
  1055.               UMSSelectFlags(account,"L",,,,,"L",l_newlist,l_newlist))
  1056.  
  1057.   configChanged = false
  1058.   curmsg = 0;
  1059.   do forever
  1060.     curmsg = UMSSearchFlags(account,"L",l_newlist,l_newlist,curmsg)
  1061.     if curmsg = 0 then leave
  1062.     call ProcessCtrlMsg(curmsg);
  1063.   end
  1064.  
  1065.   if configChanged then do
  1066.     call log(7,"changed config by control mail")
  1067.     if ~ WriteConfig() then call log(2,"couldn't write config")
  1068.   end
  1069.  
  1070.   do i = 1 to lists.0
  1071.     if lists.i.addr ~= "" then iterate
  1072.     shortname = lists.i.name
  1073.     longname  = "Mailinglist '"lists.i.name"'"
  1074.  
  1075.     /* create Tailer; no stems: faster */
  1076.     if args.nodeamonaccount then do
  1077.       Tailer2 = longname 'Admin: "'Lists.Owner '<'lists.address'>"'
  1078.       Tailer3 = 'Send listserv-requests to "'lists.server '<'lists.address'>"'
  1079.     end; else do
  1080.       Tailer2 = longname 'Admin: <'Lists.Owner'@'lists.hostname'>'
  1081.       Tailer3 = 'Send listserv-requests to <'lists.server'@'lists.hostname'>'
  1082.     end
  1083.     Tailer_length = max(length(tailer2), length(tailer3)) + 2
  1084.     Tailer = copies("_", tailer_length) ||LF|| center(tailer2, tailer_length) ||LF|| center(tailer3, tailer_length) ||LF
  1085.     /* drop Tailer. superfluous */
  1086.  
  1087.     /*** process received mails in lists ***/
  1088.     call log(7,"processing list <"shortname">")
  1089.  
  1090.     call UMSSelectFlags(account,"L",,l_name,,,"L",l_name,l_name)
  1091.     call UMSSelectField(account,"L",l_name,,,,UMSCODE_ToName,longname,true)
  1092.     call UMSSelectField(account,"L",l_name,,,,UMSCODE_ToName,shortname,true)
  1093.     if lists.i.alias ~= "" then do
  1094.       call UMSSelectField(account,"L",l_name,,,,UMSCODE_ToName,lists.i.alias,true)
  1095.     end
  1096.     num = UMSSelectFlags(account,"L",,,,,"L",l_newlist,l_newlist)
  1097.     call log(6+(num=0),"new mail for <"shortname"> or <"longname">:" num)
  1098.     curmsg = 0;
  1099.     do forever
  1100.       curmsg = UMSSearchFlags(account,"L",l_newlist,l_newlist,curmsg)
  1101.       if curmsg = 0 then leave
  1102.       drop msg.
  1103.       if ~UMSReadMsgAll(account, curmsg, msg., TRUE) then do
  1104.         call CheckErr
  1105.         /* workaround for ARexx bug with msgs >64kB */
  1106.         call UMSSelectMsg(account,"U", f_X, f_Old, curmsg)
  1107.       end; else do
  1108.         if symbol("msg."UMSCODE_FromAddr) ~= "VAR" then msg.UMSCODE_FromAddr = ""
  1109.         call log(8,curmsg msg.UMSCODE_FromName "<"msg.UMSCODE_FromAddr"> :" msg.UMSCODE_subject)
  1110.  
  1111.         /*** write news article ***/
  1112.         if lists.i.group ~= "" then do
  1113.  
  1114.           /*** set up news hdr ***/
  1115.           msg.UMSCODE_Group = lists.i.group
  1116.           msg.SOFTLINK = curmsg
  1117.           msg.NOUPDATE = args.nodeamonaccount
  1118.           drop msg.hardlink
  1119.           drop msg.UMSCODE_Comments
  1120.  
  1121.           /* Dupe Check */
  1122.           call UMSSelectFlags(account, "L", f_X, f_EF,,, "L", f_X, f_X)
  1123.           call UMSSelectField(account, "L", f_F, f_X,,, UMSCODE_Group, msg.UMSCODE_Group, TRUE)
  1124.           call UMSSelectField(account, "L", f_E, f_X,,, UMSCODE_MsgID, msg.UMSCODE_MsgID, TRUE)
  1125.           if UMSSearchFlags(account, "L", f_EF, f_EF) ~= 0 then do
  1126.             call log(2,"rejected dupe <"msg.UMSCODE_MsgID"> written by '"msg.UMSCODE_FromName ||,
  1127.                        "' intended for '"msg.UMSCODE_Group"'")
  1128.           end; else do
  1129.             /*** write article ***/
  1130.             newnum = UMSWriteMsg(account,msg.)
  1131.             if newnum = 0 then call CheckErr
  1132.             else do
  1133.               call log(9,"write article:" newnum)
  1134.             end
  1135.             call SendListMails /* mail hdr is set up there */
  1136.           end
  1137.         end
  1138.         call UMSSelectMsg(account,"U", f_Old, f_X, curmsg)
  1139.       end
  1140.     end
  1141.  
  1142.     /*** process new news ***/
  1143.  
  1144.     if lists.i.group ~= "" then do
  1145.       listgroup = lists.i.group
  1146.       call UMSSelectFlags(account,"L",,l_group,,,"L",l_group,l_group)
  1147.       call UMSSelectField(account,"L",l_group,,,,UMSCODE_Group,listgroup,true)
  1148.       num = UMSSelectFlags(account,"L",,,,,"L",l_newnews,l_newnews)
  1149.       call log(6+(num=0), "New articles in group <"listgroup">:" num)
  1150.       curmsg = 0;
  1151.       do forever
  1152.         curmsg = UMSSearchFlags(account,"L",l_newnews,l_newnews,curmsg)
  1153.         if curmsg = 0 then leave
  1154.         drop msg.
  1155.         if ~UMSReadMsgAll(account, curmsg, msg., TRUE) then do
  1156.           call CheckErr
  1157.           /* workaround for ARexx bug with msgs >64kB */
  1158.           call UMSSelectMsg(account,"U", f_X, f_Old, curmsg)
  1159.         end; else do
  1160.           if symbol("msg."UMSCODE_fromAddr) ~= "VAR" then msg.UMSCODE_FromAddr = ""
  1161.           call log(8,curmsg msg.UMSCODE_fromName "<"msg.UMSCODE_FromAddr"> :" msg.UMSCODE_subject)
  1162.  
  1163.           /*** set up mail hdr ***/
  1164.           drop msg.hardlink msg.UMSCODE_Comments
  1165.           msg.softlink = curmsg
  1166.           call SendListMails;  /* rest of mail hdr ist set there */
  1167.           call UMSSelectMsg(account,"U", f_bit, f_X, curmsg)
  1168.         end
  1169.       end
  1170.     end
  1171.   end
  1172.  
  1173. return
  1174.  
  1175. /*** Support ***/
  1176.  
  1177. FindFlag: PROCEDURE expose account ProgramName TRUE
  1178.   temp = UMSReadConfig(account,"flags.user",,TRUE) /* need param to lock! */
  1179.   if temp = "" then do
  1180.     myflag = -1
  1181.     freeflag = 0
  1182.   end; else do
  1183.     do until temp = ""
  1184.       parse var temp flagnum flagkey '0A'x temp
  1185.       flag.flagnum = strip(flagkey)
  1186.     end
  1187.  
  1188.     freeflag = -1
  1189.     myflag = -1
  1190.  
  1191.     do i = 0 to 15
  1192.       if flag.i = programname then do
  1193.         myflag = i
  1194.         leave
  1195.       end; else do
  1196.         if (upper(flag.i) = "UNUSED") & (freeflag = -1) then do
  1197.           freeflag = i
  1198.         end
  1199.       end
  1200.     end
  1201.   end
  1202.  
  1203.   if myflag = -1 then do
  1204.     if freeflag ~= -1 then do
  1205.       /* I've been started for the first time. I'm reserving first free flag */
  1206.       myflag = freeflag
  1207.       flag.myflag = programname
  1208.       do i = 0 to 15
  1209.         if symbol("flag."i) ~= "VAR" then do
  1210.           if (i >= 4) & (i <= 12) then do
  1211.             flag.i = "Reserved"
  1212.           end; else do
  1213.             flag.i = "Unused"
  1214.           end
  1215.         end
  1216.         temp = temp || i flag.i || '0A'x
  1217.       end
  1218.       if ~UMSWriteConfig(account,"flags.user",temp,,TRUE) then do /* need param to unlock! */
  1219.         call CheckErr
  1220.       end
  1221.     end
  1222.   end
  1223. return myflag
  1224.  
  1225. Include: PROCEDURE expose account args.debuglevel ProgramName
  1226.   if open(file,arg(1),r) then do
  1227.     string = readch(file,64000)
  1228.     call close(file)
  1229.   end; else do
  1230.     call log(2,"cannot read include-file '"arg(1)"'!")
  1231.     string = ""
  1232.   end
  1233. return string
  1234.  
  1235. log: PROCEDURE expose account args.debuglevel ProgramName
  1236.   level = arg(1); text = ProgramName":" arg(2);
  1237.   if level <= args.debuglevel then say text
  1238.   call UMSLog(account, level, text)
  1239. return 0
  1240.  
  1241. CheckErr: PROCEDURE expose account args.debuglevel ProgramName
  1242.   err = UMSErrNum(account)
  1243.   if err ~= 0 then do
  1244.     call log(3,"UMS Error #"err":" UMSErrTxt(account))
  1245.   end
  1246. return 0
  1247.